home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / p063b9s.zip / UNIT / AMLIST.PAS < prev    next >
Pascal/Delphi Source File  |  1996-04-20  |  9KB  |  295 lines

  1. UNIT AMList;
  2. {╔══════════════════════════════════════════════════════════════════════════╗}
  3. {║ File areamanager # Areaman                    Last changed: 20.04.96  SA ║}
  4. {║                                                                          ║}
  5. {║                         (C) Copyright 1989-95 by                         ║}
  6. {║       Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager        ║}
  7. {║                                                                          ║}
  8. {║ This source may not be given to anybody, without the written permission  ║}
  9. {║ from The Portal Team.                                                    ║}
  10. {╚══════════════════════════════════════════════════════════════════════════╝}
  11. {$I POPDEFS.INC}
  12.  
  13. INTERFACE
  14.  
  15. USES Use32, OpWindow, OpPick;
  16.  
  17. TYPE
  18.    Alistptr           = ^Alist;
  19.  
  20.    AreaSearchFunc     = Procedure (A : AlistPtr);
  21.  
  22.    Alist = Object(Picklist)
  23.     Temp,
  24.     FileMgrWin,
  25.     MainFuncKeyWin : WindowPtr;
  26.     ShowPath,
  27.     movemode    : Boolean;
  28.     MaxLine     : Byte;
  29.     FirstShown,
  30.     CurrentArea,
  31.     Startline,
  32.     TopArea,io,
  33.     AreaLine    : Integer;
  34.     FileFinder  : AreaSearchFunc;
  35.  
  36.     Constructor InitAreaManager;
  37.     DeStructor FinishAreaManager;
  38.     PROCEDURE AreaList;
  39.     PROCEDURE DiskSpaceStatistics;
  40.     PROCEDURE ShowFileAreas;
  41.  {  PROCEDURE FindFile; { Original code provided by Steen Buch Christensen }
  42.     FUNCTION ChooseFileArea(VAR InKey: Word): Boolean;
  43.   END;
  44.  
  45. IMPLEMENTATION
  46.  
  47. USES Dos,OpCrt, OpString, OpRoot, OpKey,
  48.      AreaMan, Input, Util, OproUtil, FileUtil, KeyBoard, Globals, PopTypes;
  49.  
  50.   Constructor Alist.InitAreaManager;
  51.   BEGIN
  52.     ShowPath:=FALSE;
  53.     movemode:=FALSE;
  54.     FirstShown:=0;
  55.     CurrentArea:=0;
  56.     TopArea:=0;
  57.     MyWin(MainFuncKeyWin,1,ScreenHeight-2,80,ScreenHeight,2,'',False);
  58.     MyWin(FileMgrWin,1,2,80,ScreenHeight-3,2,'File area manager',False);
  59.     AreaLine:=1;
  60.   END;
  61.  
  62.   Destructor Alist.FinishAreaManager;
  63.   BEGIN
  64.     KillWindow(FileMgrWin);
  65.     KillWindow(MainFuncKeyWin);
  66.     ChangeDir(StartPath);
  67.   END;
  68.  
  69.   PROCEDURE Alist.AreaList;
  70.   VAR
  71.     f : TBufTextFile;
  72.     filename:PathStr;
  73.     i : Integer;
  74.   BEGIN
  75.     FileName:=Cfg.BBS.Path+'AREALIST.TXT';
  76.     IF InputString(10,8,67,43,3,'Area List','Output Name : ',FileName) THEN
  77.     BEGIN
  78.       IF f.Init(FileName, SCreate, 2048) THEN
  79.       BEGIN
  80.         FOR i:=1 TO NumArea DO
  81.           WITH Area^[i]^ DO
  82.             f.WriteLn(Tag^+' '+title^+CharStr(' ',80-Length(title^))+' '+Path^);
  83.         f.Done;
  84.       END;
  85.     END;
  86.   END;
  87.  
  88.  
  89.   PROCEDURE Alist.DiskSpaceStatistics;
  90.   TYPE
  91.     TabType=RECORD
  92.       Free,
  93.       Size  : LONGINT;
  94.     END;
  95.   VAR
  96.     Tab  : ARRAY['A'..'Z'] OF TabType;
  97.     i,l  : Byte;
  98.     Ch,sd: Char;
  99.     s    : STRING;
  100.     Temp2 : WindowPtr;
  101.     TotalSize,TotalFree:LONGINT;
  102.   BEGIN
  103.     MyWin(Temp2,3,3,78,ScreenHeight,4,'Disk space statistics',False);
  104.     With Cfg.Color[4] DO
  105.       Temp2^.wFastWrite(Pad('Drive  Total Size    Free Space  %Free  Drive Type',Temp2^.Width),1,1,TextColor);
  106.     l:=1;
  107.     FILLCHAR(tab,SizeOf(Tab),0);
  108.     TotalSize:=0; TotalFree:=0;
  109.     FOR i:=1 TO NumArea DO
  110.     BEGIN
  111.       ch:=Area^[i]^.Path^[1];
  112.       WITH Tab[ch] DO
  113.         IF Size=0 THEN
  114.         BEGIN
  115.           Size:=DriveSize(ORD(ch)-64);
  116.           IF Size>0 THEN
  117.           BEGIN
  118.             Inc(TotalSize,Size);
  119.             Free:=DriveFree(ORD(ch)-64);
  120.             Inc(TotalFree,Free);
  121.           END;
  122.         END;
  123.     END;
  124.     InOutRes:=0;
  125.     FOR ch:='A' TO 'Z' DO
  126.       WITH Tab[ch] DO
  127.         IF Size<>0 THEN
  128.         BEGIN
  129.           Inc(l);
  130.           s:=' '+ch+': '+LongIntForm('#,###,###,###',Size)+' '+LongIntForm('#,###,###,###',Free)+
  131.              Form('  ###.#  ',Round(Free)*100.0/Round(Size));
  132.           s:=s+GetDiskString(Ch);
  133.  
  134.           Temp2^.wFastWrite(Pad(s,Temp2^.Width),l,1,Cfg.Color[4].HighLightColor);
  135.         END;
  136.     IF TotalSize>0 THEN
  137.     BEGIN
  138.       Temp2^.wFastWrite(CharStr('-',Temp2^.Width),l+1,1,Cfg.Color[3].TextColor);
  139.       s:='ALL '+LongIntForm('#,###,###,###',TotalSize)+' '+LongIntForm('#,###,###,###',TotalFree)+
  140.          Form('  ###.#  ',Round(TotalFree)*100.0/Round(TotalSize));
  141.       Temp2^.wFastWrite(Pad(s,Temp2^.Width),l+2,1,Cfg.Color[3].TextColor);
  142.     END;
  143.     REPEAT
  144.     UNTIL GotESC;
  145.     KillWindow(Temp2);
  146.   END;
  147.  
  148.   PROCEDURE Alist.ShowFileAreas;
  149.   VAR
  150.     S : String;
  151.     i   : Integer;
  152.     Len : Byte;
  153.   BEGIN
  154.     WITH Temp^ DO
  155.     BEGIN
  156.       FOR i:=1 TO Height DO
  157.       BEGIN
  158.         IF i+TopArea<=NumArea THEN
  159.         BEGIN
  160.           CASE Cfg.BBS.BBSType OF
  161.             btMax     : Len:=10;
  162.             btOpus170 : Len:=6;
  163.             ELSE        Len:=4;
  164.           END;
  165.           IF Len<>10 THEN
  166.             s:=LeftPad(Area^[i+TopArea]^.tag^,Len)+' '
  167.           ELSE
  168.             s:=' '+Pad(Trim(Area^[i+TopArea]^.tag^),Len);
  169.           IF NOT ShowPath THEN s:=s+' '+Area^[i+TopArea]^.title^
  170.                           ELSE s:=s+Area^[i+TopArea]^.path^;
  171.           IF Length(s)<74 THEN s:=s+charstr(' ',74-Length(s)) ELSE
  172.             IF Length(s)>76 THEN s[0]:=#76;
  173.           MaxLine:=i;
  174.         END ELSE
  175.           s:=charstr(' ',76);
  176.         wFastWrite(s,i,1,cfg.color[3].TextColor);
  177.       END;
  178.       IF AreaLine>MaxLine THEN AreaLine:=MaxLine;
  179.     END;
  180.   END;
  181.  
  182.  
  183.   FUNCTION Alist.ChooseFileArea(VAR InKey: Word): Boolean;
  184.   LABEL Start;
  185.   VAR
  186.     FuncKeyWin       : windowptr;
  187.     test,j           : Integer;
  188.     s                : String;
  189.   BEGIN
  190.     BEGIN
  191.       StartLine:=0;
  192.       MyWin(FuncKeyWin,1,ScreenHeight-1,80,ScreenHeight,2,'',False);
  193.       FuncKeyWin^.wFastWrite('F5=Glob. search',1,64,cfg.color[2].HighLightColor);
  194.       FuncKeyWin^.wFastWrite('F7=Area list    F8=Disk space   F9=Path/title   F10=Goto area #',2,16,
  195.                              cfg.color[2].HighLightColor);
  196.       MyWin(Temp,1,2,80,ScreenHeight-2,3,'Choose file area',False);
  197. Start:
  198.       ShowFileAreas;
  199.       REPEAT
  200.         Topic:=50;
  201.         CHANGEATTRIBUTE(76,2+AreaLine,3,cfg.color[3].BlockColor);
  202.         InKey:=PopReadKeyWord;
  203.         CHANGEATTRIBUTE(76,2+AreaLine,3,cfg.color[3].TextColor);
  204.         CASE InKey OF
  205.             F5 : Filefinder(@Self);
  206.             F7 : AreaList;
  207.             F8 : DiskSpaceStatistics;
  208.             F9 : BEGIN
  209.                    ShowPath:=NOT ShowPath;
  210.                    ShowFileAreas;
  211.                  END;
  212.            F10 : BEGIN
  213.                    s:='';
  214.                    IF InputString(30,8,9,9,4,'Goto area','Area # : ',s) THEN
  215.                    BEGIN
  216.                      j:=0;
  217.                      REPEAT
  218.                        Inc(j);
  219.                      UNTIL (j=NumArea) OR (Trim(s)=Trim(Area^[j]^.tag^));
  220.                      IF Trim(s)=Trim(Area^[j]^.tag^) THEN
  221.                      BEGIN
  222.                        StuffKey(Enter);
  223.                        TopArea:=j-1;
  224.                        AreaLine:=1;
  225.                      END;
  226.                    END;
  227.                  END;
  228.            Home: BEGIN
  229.                    TopArea:=0;
  230.                    ShowFileAreas;
  231.                    AreaLine:=1;
  232.                  END;
  233.             Up : BEGIN
  234.                    IF AreaLine>1 THEN Dec(AreaLine) ELSE
  235.                      IF TopArea>0 THEN
  236.                      BEGIN
  237.                        Dec(TopArea);
  238.                        ShowFileAreas;
  239.                      END;
  240.                  END;
  241.            PgUp: BEGIN
  242.                    AreaLine:=AreaLine-Temp^.Height-1;
  243.                    WHILE AreaLine<1 DO
  244.                    BEGIN
  245.                      Inc(AreaLine);
  246.                      IF TopArea>0 THEN Dec(TopArea);
  247.                    END;
  248.                    ShowFileAreas;
  249.                  END;
  250.          EndKey: BEGIN
  251.                    TopArea:=NumArea-Temp^.Height;
  252.                    AreaLine:=Temp^.Height;
  253.                    WHILE TopArea<0 DO
  254.                    BEGIN
  255.                      Inc(TopArea);
  256.                      DEC(AreaLine);
  257.                    END;
  258.                    ShowFileAreas;
  259.                  END;
  260.            Down: BEGIN
  261.                    IF (TopArea+AreaLine<NumArea) AND (AreaLine<MaxLine) THEN Inc(AreaLine) ELSE
  262.                      IF TopArea+AreaLine<NumArea THEN
  263.                      BEGIN
  264.                        Inc(TopArea);
  265.                        ShowFileAreas;
  266.                      END;
  267.                  END;
  268.            PgDn: BEGIN
  269.                    AreaLine:=AreaLine+Temp^.Height-1;
  270.                    WHILE AreaLine>Temp^.Height DO
  271.                    BEGIN
  272.                      Dec(AreaLine);
  273.                      IF TopArea<NumArea-1 THEN Inc(TopArea);
  274.                    END;
  275.                    ShowFileAreas;
  276.                  END;
  277.           END;
  278.       UNTIL (InKey=Enter) OR (Inkey=Esc);
  279.       IF InKey=Enter THEN
  280.       BEGIN
  281.         CurrentArea:=TopArea+AreaLine;
  282.         IF NOT ChangeDir(Area^[CurrentArea]^.path^) THEN
  283.         BEGIN
  284.           AskError(8, 'Path for this area does NOT exist', 4);
  285.           GOTO Start;
  286.         END;
  287.       END;
  288.       KillWindow(Temp);
  289.       KillWindow(FuncKeyWin);
  290.       ChooseFileArea:=(InKey<>Esc);
  291.     END;
  292.   END;
  293.  
  294. END.
  295.